home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol020 / xref1.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  7.1 KB  |  185 lines
  1. 1010 PROG$="XREF1.BAS":VERS$="82/09/22/2300"
  2. 1020 CLS:KEY OFF
  3. 1030 PRINT "CROSSREF   Copyright (C) 1980 by ADVANCED INFORMATICS"
  4. 1040 PRINT
  5. 1050 PRINT "Distributed by Baltimore IBM PC    Not for sale or commercial use"
  6. 1060 PRINT PROG$;TAB(20);"Version of ";VERS$
  7. 1070 PRINT:PRINT "           Initializing . . . ":PRINT
  8. 1080 '
  9. 1090 DEFINT I-J:LW=79
  10. 1100 ON ERROR GOTO 2760
  11. 1110 DIM RW$(165),PT%(25),F$(10)
  12. 1120 DIM VNXT%(490),V$(490),FRST%(400),LST%(400),RFL%(2000),NXT%(2000)
  13. 1130 '
  14. 1140 ' Reserved words -- see page 3.6 of BASIC 1.1 manual
  15. 1150 '
  16. 1160 DATA ABS,AND,ASC,AS,ATN,AUTO,BEEP,BLOAD,BSAVE
  17. 1170 DATA CALL,CDBL,CHAIN,CHR$,CINT,CIRCLE,CLEAR,CLOSE,CLS,COLOR,COM
  18. 1180 DATA COMMON,CONT,COS,CSNG,CSRLIN,CVD,CVI,CVS
  19. 1190 DATA DATA,DATE$,DEF,DEFDBL,DEFINT,DEFSNG,DEFSTR,DELETE,DIM,DRAW
  20. 1200 DATA EDIT,ELSE,END,EOF,EQV,ERASE,ERL,ERR,ERROR,EXP,FIELD,FILES,FIX,FN,FOR
  21. 1210 DATA FRE,GET,GOSUB,GOTO,HEX$
  22. 1220 DATA IF,IMP,INKEY$,INP,INPUT,INPUT#,INPUT$,INSTR,INT,KEY,KILL,LEFT$,LEN
  23. 1230 DATA LET,LINE,LIST,LLIST,LOAD,LOC,LOCATE,LOF,LOG,LPOS,LPRINT,LSET
  24. 1240 DATA MERGE,MID$,MKD$,MKI$,MKS$,MOD,MOTOR
  25. 1250 DATA NAME,NEW,NEXT,NOT,OCT$,OFF,ON,OPEN,OPTION,OR,OUT
  26. 1260 DATA PAINT,PEEK,PEN,PLAY,POINT,POKE,POS,PRESET
  27. 1270 DATA PRINT,PRINT#,PSET,PUT,RANDOMIZE
  28. 1280 DATA READ,REM,RENUM,RESET,RESTORE,RESUME,RETURN,RIGHT$,RND,RSET,RUN
  29. 1290 DATA SAVE,SCREEN,SGN,SIN,SOUND,SPACE$,SPC(,SQR
  30. 1300 DATA STEP,STICK,STOP,STR$,STRIG
  31. 1310 DATA STRING$,SWAP,SYSTEM,TAB(,TAN,THEN,TIME$,TO,TROFF,TRON
  32. 1320 DATA USING,USR,VAL,VARPTR,VARPTR$
  33. 1330 DATA WAIT,WEND,WHILE,WIDTH,WRITE,WRITE#,XOR,"\"
  34. 1340 '
  35. 1350 ' Fill array with reserved words
  36. 1360 '
  37. 1370 RW%=0
  38. 1380 READ RW$
  39. 1390 RW%=RW%+1:RW$(RW%)=RW$:IF RW$="\" THEN 1430
  40. 1400 I=ASC(RW$)-ASC("A"):IF PT%(I)=0 THEN PT%(I)=RW%
  41. 1410 GOTO 1380
  42. 1420 '
  43. 1430 FOR I=0 TO 25:IF PT%(I)=0 THEN PT%(I)=RW%
  44. 1440 NEXT
  45. 1450 '
  46. 1460 ' Get list of file names
  47. 1470 '
  48. 1480 FX=0
  49. 1490 PRINT:PRINT " Input filespec for ASCII-saved BASIC program #" FX+1 " = ";
  50. 1500 LINE INPUT L$
  51. 1510 IF L$="" THEN IF FX<1 THEN 1760 ELSE 1580
  52. 1520 IF INSTR(L$,".")=0 THEN L$=L$+".BAS"
  53. 1530 NAME L$ AS L$
  54. 1540 FX=FX+1:F$(FX)=L$
  55. 1550 IF FX>9 THEN 1580
  56. 1560 GOTO 1490
  57. 1570 '
  58. 1580 OD$="LPT1:":PRINT:LINE INPUT " Output filespec (default LPT1:) = ";TEMP$
  59. 1590 IF TEMP$="" THEN 1600 ELSE OD$=TEMP$
  60. 1600 IF LEFT$(OD$,3)="COM" AND MID$(OD$,5,1)=":" THEN OPEN OD$ AS 3
  61. 1610 IF LEFT$(OD$,3)<>"COM" THEN OPEN "O",3,OD$
  62. 1620 IF LEFT$(OD$,3)="LPT" AND MID$(O$,5,1)=":" THEN WIDTH #3,81
  63. 1630 PRINT: INPUT "1=>Cross reference;  2=>List;  3=>Both ";M
  64. 1640 '
  65. 1650 ' Process list of input file names
  66. 1660 '
  67. 1670 STIME$=TIME$:PRINT:PRINT "Started processing at ";STIME$
  68. 1680 FOR F=1 TO FX
  69. 1690 CLOSE 1:OPEN "I",1,F$(F)
  70. 1700 PRG$="'"+F$(F)+"'       "+DATE$+"     "+STIME$
  71. 1710 GOSUB 1800 ' Main processing routine
  72. 1720 NEXT F
  73. 1730 PRINT #3,CHR$(12);:SOUND 2000,5:SOUND 3000,5:SOUND 2000,5
  74. 1740 PRINT:PRINT "Started at ";STIME$;"    Ended at ";TIME$
  75. 1750 PRINT:PRINT "NORMAL END OF JOB"
  76. 1760 KEY ON:END
  77. 1770 '
  78. 1780 ' Initialize for cross reference
  79. 1790 '
  80. 1800 LC=0:BC=0:PZ%=0:V$="":C$="":VC%=91:RC%=-1
  81. 1810 FOR I=0 TO 91: VNXT%(I)=-1: NEXT
  82. 1820 IF M>1 THEN GOSUB 2800 ' Start new page if listing requested
  83. 1830 '
  84. 1840 ' Input line and extract line number
  85. 1850 '
  86. 1860 IF EOF(1) THEN 2430
  87. 1870 LINE INPUT #1,L$: IF M>1 THEN GOSUB 2680: IF M=2 THEN 1860
  88. 1880 LG=LEN(L$): BRNCH%=0: ER$="": LC=LC+1: BC=BC+LG
  89. 1890 LP%=INSTR(L$," "): LN=VAL(LEFT$(L$,LP%))
  90. 1900 IF LEFT$(OD$,5)="SCRN:" AND M=3 THEN 1910 ELSE PRINT USING " ###### ";LN;
  91. 1910 IF LN>32767 THEN LN=LN-65536!
  92. 1920 '
  93. 1930 ' Parse rest of line
  94. 1940 '
  95. 1950 LP%=LP%+1: IF LP%>LG THEN GOSUB 2240: GOTO 1860
  96. 1960 C$=MID$(L$,LP%,1)
  97. 1970 IF C$>="A" AND C$<="Z" THEN 2110 ELSE IF C$>="0" AND C$<="9" THEN 2380
  98. 1980 IF V$<>"" AND C$="." THEN 2110
  99. 1990 IF C$=" " THEN GOSUB 2240: GOTO 1950 ELSE IF C$<>","THEN BRNCH%=0
  100. 2000 IF C$=CHR$(34) THEN GOSUB 2240
  101. 2010 IF C$=CHR$(34) THEN LP%=INSTR(LP%+1,L$,C$):IF LP%>0 THEN 1950 ELSE 1860
  102. 2020 IF C$="'" THEN GOSUB 2240: GOTO 1860
  103. 2030 IF C$="&" THEN GOSUB 2240: V$=C$: GOTO 1950
  104. 2040 IF C$="$" OR C$="!" OR C$="%" OR C$="#" THEN GOSUB 2360:GOTO 1950
  105. 2050 IF C$="(" THEN GOSUB 2360
  106. 2060 GOSUB 2240: IF C$<>"," THEN ER$=""
  107. 2070 GOTO 1950
  108. 2080 '
  109. 2090 ' Test for command
  110. 2100 '
  111. 2110 IF V$>"" THEN 2390 ELSE C%=ASC(C$): P%=PT%(C%-ASC("A")): BRNCH%=0
  112. 2120 IF C%<ASC(RW$(P%))  THEN 2390
  113. 2130 IF INSTR(LP%,L$,RW$(P%))<>LP% THEN P%=P%+1: GOTO 2120
  114. 2140 T$=MID$(L$,LP%+LEN(RW$(P%)),1)
  115. 2150 IF (T$>="A" AND T$<="Z") OR (T$>="0" AND T$<="9") OR T$="." THEN 2390 ELSE GOSUB 2240: RW$=RW$(P%)
  116. 2160 IF RW$="DATA" THEN  LP%=INSTR(LP%,L$," "): IF LP%>0 THEN 1950 ELSE 1860
  117. 2170 IF RW$="REM" THEN 1860
  118. 2180 IF RW$="GOTO" OR RW$="GOSUB" OR RW$="THEN" OR RW$="ELSE" OR RW$="RESUME" THEN BRNCH%=1
  119. 2190 IF RW$="ERASE" THEN ER$="(" ELSE ER$=""
  120. 2200 LP%=LP%+LEN(RW$)-1:GOTO 1950
  121. 2210 '
  122. 2220 ' End variable
  123. 2230 '
  124. 2240 IF V$="" THEN RETURN
  125. 2250 IF V$>="A" THEN V$=V$+ER$: C%=ASC(V$)+1 ELSE IF V$>="0" THEN V$=RIGHT$("    "+V$,5): C%=VAL(LEFT$(V$,2)) ELSE 2320
  126. 2260 IL=-1: I=C%
  127. 2270 IF V$>V$(I) THEN IL=I: I=VNXT%(I): IF I>0 THEN 2270 ELSE 2290
  128. 2280 IF V$=V$(I) THEN J=LST%(I-91): IF RFL%(J)=LN THEN 2320 ELSE RC%=RC%+1: NXT%(J)=RC%: GOTO 2310
  129. 2290 VC%=VC%+1: IF IL>=0 THEN VNXT%(IL)=VC%
  130. 2300 V$(VC%)=V$: VNXT%(VC%)=I: RC%=RC%+1: FRST%(VC%-91)=RC%:I=VC%
  131. 2310 RFL%(RC%)=LN: NXT%(RC%)=-1: LST%(I-91)=RC%
  132. 2320 V$="": RETURN
  133. 2330 '
  134. 2340 ' Expand variable
  135. 2350 '
  136. 2360 IF V$<>"" THEN V$=V$+C$
  137. 2370 RETURN
  138. 2380 IF V$="" AND BRNCH%=0 THEN 1950
  139. 2390 V$=V$+C$: GOTO 1950
  140. 2400 '
  141. 2410 ' Cross-reference if requested
  142. 2420 '
  143. 2430 IF M=2 THEN RETURN ' Cross-reference not requested
  144. 2440 PZ%=0:LZ%=60
  145. 2450 FOR J=0 TO 91: V%=J
  146. 2460 V%=VNXT%(V%): IF V%<0 THEN 2570
  147. 2470 IF LZ%>56 THEN GOSUB 2630 ELSE SZ%=SZ%+1: IF SZ%=3 THEN GOSUB 2640
  148. 2480 RZ%=0:I=FRST%(V%-91): PRINT #3,V$(V%);
  149. 2490 IF RZ%=0 THEN  PRINT #3,TAB(16);
  150. 2500 LN=RFL%(I): IF LN<0 THEN LN=LN+65536!
  151. 2510 PRINT #3,USING "    #####";LN,
  152. 2520 RZ%=RZ%+1
  153. 2530 IF RZ%>6 THEN RZ%=0: PRINT #3,: LZ%=LZ%+1: IF LZ%>56 THEN GOSUB 2630
  154. 2540 I=NXT%(I): IF I>0 THEN 2490
  155. 2550 IF RZ%>0 THEN PRINT #3,: LZ%=LZ%+1
  156. 2560 GOTO 2460
  157. 2570 NEXT J
  158. 2580 '
  159. 2590 PRINT #3,STRING$(79,"=")
  160. 2600 PRINT #3,"LINES: "LC"    BYTES: "BC"     SYMBOLS: "VC%-91"    REFERENCES: "RC%+1
  161. 2610 LZ%=LZ%+2: RETURN
  162. 2620 '
  163. 2630 GOSUB 2800: PRINT #3,"SYMBOL" TAB(20) "REFERENCE LINE": LZ%=LZ%+1
  164. 2640 PRINT #3,STRING$(79,"-"):LZ%=LZ%+1:SZ%=0:RETURN
  165. 2650 '
  166. 2660 'List if requested
  167. 2670 '
  168. 2680 X%=1
  169. 2690 IF LZ%>60 THEN GOSUB 2800 ' If bottom of page, start new page
  170. 2700 IF RIGHT$(L$,3)="'PG" THEN GOSUB 2800 ' If 'PG ends line, start new page
  171. 2710 Y%=INSTR(X%,L$,CHR$(10))
  172. 2720 IF Y%>0 THEN PRINT #3,MID$(L$,X%,Y%-X%):LZ%=LZ%+1:X%=Y%+1:GOTO 2710
  173. 2730 PRINT #3,MID$(L$,X%,LW)
  174. 2740 LZ%=LZ%+1:X%=X%+LW: IF X%<=LEN(L$) THEN 2730 ELSE RETURN
  175. 2750 '
  176. 2760 IF ERR=53 THEN PRINT:PRINT "FILE NOT FOUND":RESUME 1490
  177. 2770 IF ERR=58 THEN RESUME 1540 ' File already exists -- see NAME AS line
  178. 2780 ON ERROR GOTO 0
  179. 2790 '
  180. 2800 PRINT #3,CHR$(12);   ' Form feed
  181. 2810 PZ%=PZ%+1:PRINT #3,PRG$;TAB(68) "PAGE"PZ%
  182. 2820 PRINT #3,:PRINT #3,
  183. 2830 LZ%=3: RETURN
  184. RINT #3,CHR$(12);   ' Form feed
  185. 2810 PZ%=PZ%+1:PRINT #3,PR